home *** CD-ROM | disk | FTP | other *** search
/ Apple Developer Connection Student Program / ADC Tools Sampler CD Disk 3 1999.iso / Cool Demos, SDKs, & Tools / Demos⁄Tools⁄Offers / Alpha ƒ / Tcl / Packages / Docprojects.tcl < prev    next >
Text File  |  1999-04-26  |  34KB  |  1,035 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "Docprojects.tcl"
  6.  #                                    created: 29/7/97 {4:59:22 pm} 
  7.  #                                last update: 04/26/1999 {16:32:59 PM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Copyright (c) 1997-1999  Vince Darley, all rights reserved
  15.  # 
  16.  # See the file "license.terms" for information on usage and redistribution
  17.  # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  18.  # ###################################################################
  19.  ##
  20.  
  21. alpha::extension documentProjects 1.6.4 {
  22.     set alpha::prefs(documentProjects) Docproj
  23.     alpha::package require AlphaTcl 7.2fc7
  24.     namespace eval Docproj {}
  25.     # dummy value
  26.     ensureset docProject(name) [list "None" "Project2" "Thesis"]
  27.     # The name of the current project.  Every project has a unique name
  28.     newPref var currentProject "None" Docproj "" docProject(name) "varitem"
  29.     # Different identities can be useful if your projects may be sometimes
  30.     # for work purposes, sometimes for your own purposes etc.
  31.     newPref var identity Usual Docproj Docproj::changeIdentity identities "array"
  32.     menu::buildProc "Current Project" \
  33.       {menu::buildFlagMenu "Current Project" list currentProject DocprojmodeVars}
  34.     menu::insert packages submenu 1 {Current Project}
  35.     menu::insert packages items 1 \
  36.       "documentProjectPrefs…" "userDetails…" \
  37.       "<E<SremoveDocumentTemplate…" "<S<BeditDocumentTemplate…" \
  38.       "<SnewDocumentTemplate…" \
  39.       "<E<SremoveProject…" "<S<BeditProject…" "<SnewProject…"
  40.     # Key-binding to update the version number in a file's header.
  41.     # These version numbers can be inserted by some of the standard
  42.     # document templates.
  43.     newPref binding updateFileVersion "/f<U" Docproj
  44.     menu::insert winUtils items end \
  45.       "updateDate" \
  46.       "[menu::bind DocprojmodeVars(updateFileVersion) -]"
  47.     lunion elec::MenuTemplates "createHeader" "newDocument"
  48.     catch "unBind F1 bind::Completion"
  49.     menu::insert elec items end \
  50.       {Menu -n FunctionComments -p menu::generalProc {
  51.     "/eusual"    
  52.     "/e<Isimple" 
  53.     "/e<OwithAuthor" 
  54.     "/e<Uupdate" 
  55.     }}
  56.     hook::register requireOpenWindowsHook [list $electricMenu FunctionComments] 1
  57.     namespace eval newDocument {}
  58.     set "newDocument::handlers(Document Projects)" Docproj::newHandler
  59.     # Use this simple proc if we don't have the newDocument package.
  60.     if {![alpha::package exists newDocument]} {
  61.     ;proc file::newDocument {} {
  62.         beep
  63.         Docproj::newHandler [list -n [statusPrompt "New doc name:"]]
  64.     }
  65.     } else {
  66.     alpha::package require newDocument
  67.     }
  68.     
  69.     # When you request a new document, if this flag is set the user
  70.     # is only prompted with a list of document templates which 
  71.     # are relevant to the current mode.  This can be useful if you 
  72.     # have lots of templates.
  73.     newPref flag docTemplatesModeSpecific 1 Docproj
  74.     # When a file is saved, its header (time-stamp) etc can be
  75.     # automatically updated.
  76.     newPref flag autoUpdateHeader 1 Docproj
  77.     # call on saveHook
  78.     proc Docproj::changeProject {name} {
  79.     if {$name == "*"} { return }
  80.     menu::flagProc "Current Project" $name
  81.     }
  82.     
  83.     # call on saveHook
  84.     hook::register saveHook updateHeaderHook
  85. } maintainer {
  86.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  87. } uninstall {this-file} help {file "Documentprojects Help"}
  88.  
  89. # user projects
  90. if {![info exists docProject(addendum)]} {
  91.     set docProject(addendum) { {none} {about some other stuff} {deep problems}}
  92.     set docProject(default_modes) { {} {C++ Tcl} {TeX}}
  93.     set docProject(extra) [list "" "Freely distributable" "Copyright (C) 1997-1998 the author."]
  94.     set docProject(license) [list "" "" ""]
  95. }
  96.  
  97.  
  98. proc updateHeaderHook {name} {
  99.     global DocprojmodeVars
  100.     if {$DocprojmodeVars(autoUpdateHeader)} {
  101.     # update does no harm if it fails so we call it for all
  102.     # modes with no worries.
  103.     getWinInfo -w $name a
  104.     if {$a(dirty)} {
  105.         file::updateDate $name
  106.     }
  107.     }
  108. }
  109.  
  110. # header/source templates (NOTE: FORMAT OF THIS LIST MAY CHANGE)
  111. llunion elec::DocTemplates 1 \
  112.   { * "Empty" * "" *} \
  113.   { * "Default" * t_default *} \
  114.   { TeX "Basic LaTeX document" "None" t_latex * {article report letter book slides}} \
  115.   { C++ "Basic C++ header file" "Header" t_cpp_header * } \
  116.   { C++ "Basic C++ source file" "Source" t_cpp_source * } \
  117.   { HTML "HTML document" * t_html * } 
  118. ## 
  119.  # \
  120.  # { C++ "Cpptcl Class Source" Source t_cpptcl_source "Cpptcl"} \
  121.  # { C++ "Cpptcl Class Header" Header t_cpptcl_header "Cpptcl"} \
  122.  # { Tcl "Itcl Class" * t_itcl_class "Cpptcl"}  \
  123.  # { Tcl "Blank Tcl Header" Header "\#" "Vince's Additions"} \
  124.  # { C++ "EvoX Class Source" Source t_cpptcl_source "EvoX"} \
  125.  # { C++ "EvoX Class Header" Header t_cpptcl_header "EvoX"}
  126.  ##
  127.  
  128. # used for file description headers
  129. if {$synchroniseWithInternetConfig} {
  130.     catch {set user(author) [icGetPref RealName]}
  131.     catch {set user(email) "<[icGetPref Email]>"}
  132.     catch {set user(www) "<[icGetPref WWWHomePage]>"}
  133.     catch {set user(organisation) [icGetPref Organization]}
  134. } 
  135. ensureset user(author) "Ken McKen"
  136. ensureset user(email) "ken@kenny.com"
  137. ensureset user(www) "http://www.kenny.com/"
  138. ensureset user(organisation) "Ken Corp."
  139.  
  140. ensureset user(address) "Rose St, MA 02143, USA"
  141. ensureset user(author_initials) "VMD"
  142.  
  143. ensureset identities(Usual) [array get user]
  144.  
  145. proc Docproj::changeIdentity {var} {
  146.     global identities user DocprojmodeVars
  147.     array set user $identities($DocprojmodeVars($var))
  148. }
  149.  
  150. if {[info exists DocprojmodeVars(identity)]} {
  151.     Docproj::changeIdentity identity
  152. }
  153.  
  154. proc global::userDetails {} {
  155.     global DocprojmodeVars modifiedArrayElements user identities
  156.     set oldInfo [array get user]
  157.     if {[catch {dialog::pkg_options "Docprojects" \
  158.       "User Details (some may be from Internet Config)" 1 user}] \
  159.       || ($oldInfo == [array get user])} {
  160.     return
  161.     }
  162.     set oldId $DocprojmodeVars(identity)
  163.     if {![dialog::yesno -y "Update" -n "New Identity" \
  164.       "Update $DocprojmodeVars(identity) identity, or make a new one?"]} {
  165.     # Ask for new name
  166.     set name [eval prompt [list "Enter tag for new identity" \
  167.       "<Tag>" "Old ids:"] [array names identities]]
  168.     set identities($name) [array get user]
  169.     set DocprojmodeVars(identity) $name
  170.     # Have to store Usual id too.
  171.     lappend modifiedArrayElements [list $name identities] \
  172.       [list identity DocprojmodeVars]
  173.     } else {
  174.     set identities($oldId) [array get user]
  175.     }
  176.     lappend modifiedArrayElements [list $oldId identities]
  177. }
  178.  
  179. proc global::documentProjectPrefs {} {
  180.     dialog::pkg_options "Docproj" "Preferences for your Document Projects"
  181. }
  182.  
  183. proc Docproj::newHandler {args} {
  184.     set doc [file::createDocument "new $args"]
  185.     if {[getModifiers] & 72} {
  186.     file::pickProject
  187.     }
  188.     file::createHeader $doc
  189.     return ""
  190. }
  191.  
  192. proc file::pickProject {} {
  193.     global DocprojmodeVars docProject
  194.     set item [listpick -p "Pick a project…" -L $DocprojmodeVars(currentProject) \
  195.       $docProject(name)]
  196.     if {$item != ""} {Docproj::changeProject $item }
  197.     return $item
  198. }
  199.  
  200. proc file::projectName {} { 
  201.     global DocprojmodeVars
  202.     return $DocprojmodeVars(currentProject)
  203. }
  204.  
  205. proc file::projectAddendum {} {
  206.     global docProject DocprojmodeVars
  207.     return [lindex $docProject(addendum) \
  208.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  209. }
  210.  
  211. proc file::projectExtra {} {
  212.     global docProject DocprojmodeVars
  213.     return [lindex $docProject(extra) \
  214.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  215. }
  216. proc file::projectLicense {} {
  217.     global docProject DocprojmodeVars
  218.     set ret [lindex $docProject(license) \
  219.       [lsearch -exact $docProject(name) $DocprojmodeVars(currentProject)]]
  220.     if {$ret == ""} {
  221.     return "none"
  222.     } else {
  223.     return $ret
  224.     }
  225. }
  226.  
  227. namespace eval functioncomments {}
  228.  
  229. ## 
  230.  # ----------------------------------------------------------------------
  231.  #     
  232.  #    "file::functionComment" --
  233.  #    
  234.  #  This procedure generates a nice little comment box like this one here.
  235.  #    
  236.  #   Results:
  237.  #  Well it doesn't return anything, but it allows you to enter each item
  238.  #  simply, moving from one to the next with Tab
  239.  #    
  240.  #   Side effects:
  241.  #  Not much
  242.  #    
  243.  # ----------------------------------------------------------------------
  244.  ##
  245. proc functioncomments::usual { {simple ""} {author 0} } {
  246.     global user
  247.     set fn [getSelect]
  248.     set fn [lindex $fn end]
  249.     beginningOfLine
  250.     set t "-------------------------------------------------------------------------\r"
  251.     append t "\r"
  252.     append t "\"$fn\" --\r"
  253.     append t "\r •description•\r"
  254.     if { $simple != "simple" } {
  255.     append t "\rResults:\r •results•\r\rSide effects:\r •side effects•\r"
  256.     }
  257.     if {$author} {
  258.     append t "\r--Version--Author------------------Changes-------------------------------"
  259.     append t "\r   1.0     $user(email) original\r"
  260.     }
  261.     append t "-------------------------------------------------------------------------"
  262.     set t [file::commentTextBlock $t]
  263.     elec::CenterInsertion $t
  264. }
  265.  
  266. proc functioncomments::simple {} { return [functioncomments::usual simple 0]}
  267. proc functioncomments::withAuthor {} { return [functioncomments::usual "" 1] }
  268.  
  269. proc file::commentTextBlock {text} {
  270.     set cc [commentCharacters "Paragraph"]
  271.     set c [lindex $cc 2]
  272.     regsub -all "\[\r\n\]" $text "\r${c}" text
  273.     return "[lindex $cc 0]\r[lindex $cc 2]${text}\r[lindex $cc 1]\r"
  274. }
  275.  
  276. ## 
  277.  # -------------------------------------------------------------------------
  278.  #     
  279.  #    "file::functionCommentUpdate" --
  280.  #    
  281.  #  Handles updating of a version line like the one below
  282.  #    
  283.  # --Version--Author------------------Changes-------------------------------  
  284.  #    1.0     <darley@fas.harvard.edu> original
  285.  #    1.1     <darley@fas.harvard.edu> quickly updated with shift-F1
  286.  # -------------------------------------------------------------------------
  287.  ##
  288. proc functioncomments::update {} {
  289.     global user
  290.     set begin [lindex [commentCharacters Paragraph] 2]
  291.     goto [file::findLocally "${begin}--Version--Author"]
  292.     goto [nextLineStart [nextLineStart [getPos] ]]
  293.     goto [file::findLocally "${begin}-------"]
  294.     elec::Insertion "${begin}   •Version•     $user(email) •Changes•\r"
  295. }
  296.  
  297. ## 
  298.  # -------------------------------------------------------------------------
  299.  #     
  300.  #    "file::findLocally" --
  301.  #    
  302.  #  Looks around for a particular sequence of characters (or a regexp) and
  303.  #  returns the start of the closest fit, either fowards or backwards, or
  304.  #  "" if no match was found. 
  305.  # -------------------------------------------------------------------------
  306.  ##
  307. proc file::findLocally { chars {regexp 0} { pos "" } } {
  308.     if { $pos == "" } { set pos [getPos] }
  309.     
  310.     set found1 [lindex [search -s -f 0 -n -r $regexp -- "$chars" $pos] 0]
  311.     set found2 [lindex [search -s -f 1 -n -r $regexp -- "$chars" $pos] 0]
  312.     
  313.     if { $found1 != "" && $found2 != "" } { 
  314.     if {[expr ([pos::math $pos + 0] - [pos::math $found1 + 0]) \
  315.       <= ([pos::math $found2 + 0] - [pos::math $pos + 0]) ]} {
  316.         return $found1
  317.     } else {
  318.         return $found2
  319.     }
  320.     }
  321.     
  322.     # return whatever we can, possibly ""
  323.     if { $found1 != "" } {
  324.     return $found1
  325.     } else {
  326.     if { $found2 == "" } { 
  327.         message "Couldn't find: $chars"
  328.     }
  329.     return $found2
  330.     }
  331. }
  332.  
  333.  
  334. ## 
  335.  # -------------------------------------------------------------------------
  336.  #     
  337.  #    "file::updateFileVersion"    --
  338.  #    
  339.  #  Update the version number and information in the header block of a
  340.  #  file.  Copes with both my old and new formats.
  341.  #    
  342.  # -------------------------------------------------------------------------
  343.  ##
  344. proc file::updateFileVersion {} {
  345.     global user
  346.     # in case the user wishes to return quickly
  347.     pushPosition
  348.     
  349.     goto [minPos]
  350.     set begin [lindex [commentCharacters Paragraph] 2]
  351.     set pos [file::findLocally "_/_/_" 0]
  352.     if { $pos == "" || [pos::compare $pos > [pos::math [minPos] + 1000]]} {
  353.     set srch [quote::WhitespaceReg [quote::Regfind "${begin} " ]]
  354.     append srch {[0-9]+/[0-9]+/[0-9]+}
  355.     set pos [file::findLocally $srch 1]
  356.     if { $pos == "" } {
  357.         message "Couldn't find original version template."
  358.         set srch [quote::Regfind "${begin} "]
  359.         append srch "See header file for further information"
  360.         set pos [file::findLocally [quote::WhitespaceReg $srch]]
  361.         if { $pos != "" } {
  362.         set pos [nextLineStart $pos]
  363.         } else {
  364.         goto [minPos]
  365.         set pos [file::findLocally "${begin}\#\#\#"]
  366.         if { $pos == "" } { message "Couldn't find any header" ; return }
  367.         set pos [lindex [search -s -f 1 -n -- "${begin}\#\#\#" [nextLineStart $pos]] 0]
  368.         if { $pos == "" } { message "Couldn't find any header" ; return }
  369.         }
  370.         goto $pos
  371.         set t  "${begin}\r"
  372.         append t  "${begin} modified by  rev reason\r"
  373.         append t  "${begin} ---------- --- --- -----------\r"
  374.         append t  "${begin} [file::paddedDate] $user(author_initials) 1.0 original\r"
  375.         insertText $t
  376.         select $pos [getPos]
  377.         return ""
  378.     } else {
  379.         # This is the normal case.
  380.         # Find the last version number
  381.         set p [minPos]
  382.         while {[pos::compare $p != $pos]} {
  383.         set pos $p
  384.         set p [file::findLocally $srch 1 [nextLineStart $p] ]
  385.         }
  386.         set pos [nextLineStart $pos]
  387.     }    
  388.     } else {
  389.     # old style header
  390.     set pos [lineStart $pos]
  391.     replaceText $pos [nextLineStart $pos] ""
  392.     }
  393.     # Now pos is at the start of the line where we wish to insert
  394.     goto $pos
  395.     elec::Insertion "${begin} [file::paddedDate] $user(author_initials) •• ••\r"
  396.     message "Pop position to return to where you were."
  397.     return ""
  398. }
  399.  
  400. proc file::paddedDate {{when ""}} {
  401.     if {$when == ""} { set when [now] }
  402.     return [string range "[lindex [mtime $when short] 0]     " 0 9]
  403. }
  404.  
  405. proc file::created {{convert 1}} {
  406.     if {[catch {getFileInfo [win::Current] info}]} {
  407.     if {$convert} {
  408.         return [mtime [now]]
  409.     } else {
  410.         return [now]
  411.     }
  412.     } else {
  413.     if {$convert} {
  414.         return [mtime $info(created)]
  415.     } else {
  416.         return $info(created)
  417.     }
  418.     }        
  419. }
  420.  
  421.  
  422. ## 
  423.  # -------------------------------------------------------------------------
  424.  #     
  425.  #    "file::createHeader" --
  426.  #    
  427.  #  Insert a descriptive header into the current file.  Needs to be
  428.  #  tailored more to different modes, but isn't too bad right now.
  429.  #     
  430.  #  'forcemode' will force the file into that mode via emacs-like mode
  431.  #  entries on the top line of the file.
  432.  #     
  433.  #  'parent' gives the name of a class from which the generated file
  434.  #  descends (appropriate for C++, [incr Tcl] for example).
  435.  # 
  436.  # -------------------------------------------------------------------------
  437.  ##
  438. proc file::createHeader { {template ""} {parent "" } } {
  439.     # Make sure the current project is compatible with this mode
  440.     file::coordinateProjectForMode
  441.     if {$parent == ""} {set parent "•parent•"}
  442.     if {$template == ""} { set template [list "" "" "Header" "\#" "" ""] }
  443.     # make the header
  444.     if {[lindex $template 1] != "Empty" } {
  445.     set t ""
  446.     set class [file::className]
  447.     if {$class == "Untitled"} {set class "•class name•"}
  448.     set file [win::CurrentTail]
  449.     set docHeadType [lindex $template 2]
  450.     if {$docHeadType != "None" } {
  451.         append t [file::topHeader]
  452.         if {$docHeadType != "Basic"} {
  453.         if {$docHeadType == "Source" || [file::isSource $file]} {
  454.             # it's a source file
  455.             append t " See header file for further information\r"
  456.         } elseif {$docHeadType == "Header" || $docHeadType == "*" && [file::isHeader $file]} {
  457.             global user
  458.             append t " Description: \r"
  459.             append t "\r"
  460.             append t " History\r"
  461.             append t "\r"
  462.             append t " modified by  rev reason\r"
  463.             append t " ---------- --- --- -----------\r"
  464.             append t " [file::paddedDate [file::created 0]] $user(author_initials) 1.0 original\r"
  465.         } else {
  466.             # not header or source or basic... oh well!
  467.         }
  468.         }
  469.         append t "###################################################################"
  470.         set t [file::commentTextBlock $t]
  471.         global mode
  472.         global ${mode}::firstHeaderLine
  473.         if {[info exists ${mode}::firstHeaderLine]} {
  474.         regsub "\r" $t "[quote::Regsub [set ${mode}::firstHeaderLine]]\r" t                
  475.         } else {
  476.         regsub "\r" $t "-*-${mode}-*-\r" t
  477.         }
  478.     }
  479.     set procName [lindex $template 3]
  480.     if {$procName != "\#" && [info commands $procName] == ""} { 
  481.         global PREFS
  482.         if {[catch {uplevel \#0 source [list [file join $PREFS prefs.tcl]]}]} {
  483.         alertnote "An error occurred while loading \"prefs.tcl\"" 
  484.         global errorInfo
  485.         dumpTraces "prefs.tcl error" $errorInfo
  486.         error ""
  487.         }            
  488.     }
  489.     if {[catch {append t [eval $procName [list $class] [list $parent] [lindex $template 5]]}]} {
  490.         alertnote "An error occurred while calling \"$procName\"" 
  491.         global errorInfo
  492.         dumpTraces "$procName error" $errorInfo
  493.         error ""
  494.     }
  495.     goto [minPos]
  496.     elec::Insertion $t
  497.     }
  498.     return ""
  499. }
  500.  
  501. ## 
  502.  # -------------------------------------------------------------------------
  503.  #     
  504.  #    "file::createDocument" --
  505.  #    
  506.  #  Make a new document from a given template type.
  507.  #     
  508.  #  'forcemode' will force the file into that mode via emacs-like mode
  509.  #  entries on the top line of the file.
  510.  #     
  511.  # -------------------------------------------------------------------------
  512.  ##
  513. proc file::createDocument { {winCreate ""} {forcemode "" } } {
  514.     # pick a template
  515.     # if [fileIsHeader    $file]
  516.     global elec::DocTemplates mode DocprojmodeVars
  517.     # decide if its mode-specific or not
  518.     set f [lindex $winCreate 2]
  519.     if {$DocprojmodeVars(docTemplatesModeSpecific)} {
  520.     if {$forcemode != ""} {
  521.         set tlist [file::docTemplates $f $forcemode non]
  522.     } else {
  523.         set tlist [file::docTemplates $f $mode non]
  524.     }
  525.     } else {
  526.     set tlist [file::docTemplates $f "" non]
  527.     }
  528.     lappend tlist "<Create new document type>"
  529.     if {$non != ""} {
  530.     eval lappend tlist "----------------------------------------------------" [lsort $non]
  531.     }
  532.     set tchoice [listpick -p "Pick a document template to insert" -L "Default" $tlist]
  533.     if {$tchoice == "<Create new document type>"} {
  534.     set tchoice [file::newDocumentTemplate 1]
  535.     }
  536.     if {$tchoice == "----------------------------------------------------"} { error "" }
  537.     
  538.     set tinfo [file::docTemplateInfo $tchoice]
  539.     set subTypes [lindex $tinfo 5]
  540.     if {$subTypes != ""} {
  541.     # replace the list of options with just the one selected
  542.     set tinfo [lreplace $tinfo 5 5 [listpick -p "Pick a document subtype of $tchoice" $subTypes]]
  543.     }
  544.     if {$forcemode == "" && [lindex $tinfo 0] != "*"} {
  545.     set forcemode [lindex $tinfo 0]
  546.     }
  547.     if {$winCreate != ""} {
  548.     eval $winCreate
  549.     }
  550.     
  551.     if { $forcemode != "" && $mode != $forcemode} { 
  552.     changeMode $forcemode
  553.     }
  554.     # we need to do this to stop modes switching later if this file isn't
  555.     # obviously a '$mode' file.
  556.     global win::Modes
  557.     set win::Modes($f) $mode
  558.     # set the project
  559.     Docproj::changeProject [lindex $tinfo 4]
  560.     # if the current project doesn't like this mode, then switch
  561.     file::coordinateProjectForMode
  562.     return $tinfo
  563. }
  564.  
  565. proc file::docTemplates { {f ""} {modeSpecific ""} {other ""}} {
  566.     global elec::DocTemplates
  567.     if {$other != ""} { upvar $other noList }
  568.     set tlist ""
  569.     set noList ""
  570.     if {$f != "" && $f != "Untitled"} {
  571.     set m [file::whichModeForWin $f]
  572.     foreach t ${elec::DocTemplates} {
  573.         if {[file::docTemplateMatchExt $t $f $m]} {
  574.         lappend tlist [lindex $t 1]
  575.         } else {
  576.         lappend noList [lindex $t 1]
  577.         }
  578.     }        
  579.     } else {
  580.     foreach t ${elec::DocTemplates} {
  581.         if {$modeSpecific == "" || [string match [lindex $t 0] $modeSpecific]} {
  582.         lappend tlist [lindex $t 1]
  583.         } else {
  584.         lappend noList [lindex $t 1]
  585.         }
  586.     }        
  587.     }    
  588.     return [lsort $tlist]
  589. }
  590.  
  591. proc file::docTemplateMatchExt {t f {m ""}} {
  592.     if {$m == ""} {set m [file::whichModeForWin $f]}
  593.     # match everything to a file with no particular extension
  594.     if {$m == "Text"} { return 1 }
  595.     set l [lindex $t 0]
  596.     set mMatch [expr [lsearch -exact $l $m] != -1]
  597.     switch -- [lindex $t 2] {
  598.     "None" -
  599.     "Basic" -
  600.     "*" {
  601.         if {$l == "*"} {
  602.         return 1
  603.         } else {
  604.         return $mMatch
  605.         }
  606.     }
  607.     "Header" {
  608.         if {$mMatch} {
  609.         return [file::isHeader $f $m]
  610.         }
  611.     }
  612.     "Source" {
  613.         if {$mMatch} {
  614.         return [file::isSource $f $m]
  615.         }
  616.         
  617.     }
  618.     }
  619.     return 0
  620. }
  621.  
  622. proc file::docTemplateInfo {name} {
  623.     global elec::DocTemplates
  624.     foreach t ${elec::DocTemplates} {
  625.     if {$name == [lindex $t 1]} {
  626.         return $t
  627.     }
  628.     }
  629. }
  630. proc file::docTemplateIndex {name} {
  631.     set i 0
  632.     global elec::DocTemplates
  633.     foreach t ${elec::DocTemplates} {
  634.     if {$name == [lindex $t 1]} {
  635.         return $i
  636.     }
  637.     incr i
  638.     }
  639. }
  640.  
  641. proc file::notTextMode {} {
  642.     global mode mode::features
  643.     if { $mode == "Text" } {
  644.     # we probably don't want Text mode     
  645.     set m [listpick -p "Pick a mode:" -L "Text" [array names mode::features]]
  646.     if { $m == "" } {set m "Text"}
  647.     changeMode $m
  648.     } 
  649. }
  650.  
  651. ## 
  652.  # -------------------------------------------------------------------------
  653.  #     
  654.  #    "file::topHeader"    --
  655.  #    
  656.  #  Inserts the top part of a descriptive header into the current file
  657.  # -------------------------------------------------------------------------
  658.  ##
  659. proc file::topHeader { } {
  660.     global user
  661.     set file [win::CurrentTail]
  662.     if {[catch {getFileInfo [win::Current] info}]} {
  663.     set created [mtime [now]]
  664.     set last_update $created
  665.     } else {
  666.     set created [mtime $info(created)]
  667.     set last_update [mtime $info(modified)]
  668.     }        
  669.     append t "###################################################################\r"
  670.     if {[file::projectName] != "*"} {
  671.     append t " [file::projectName] - [file::projectAddendum]\r"
  672.     }
  673.     append t "\r" 
  674.     append t " FILE: \"" $file "\"\r"
  675.     append t "                                   created: $created \r"
  676.     append t "                               last update: $last_update \r"    
  677.     append t " Author: $user(author)\r"
  678.     append t " E-mail: $user(email)\r"
  679.     if {$user(organisation) != ""} {
  680.     append t "   mail: $user(organisation)\r"
  681.     }
  682.     if {$user(address) != ""} {
  683.     append t "         $user(address)\r"
  684.     }
  685.     if {$user(www) != ""} {
  686.     append t "    www: $user(www)\r"
  687.     }
  688.     append t " \r"
  689.     append t [file::[file::projectLicense]]
  690.     if {[set e [file::projectExtra]] != ""} {
  691.     append t "[breakIntoLines $e]\r \r"
  692.     }
  693.     return $t
  694. }
  695.  
  696. ## 
  697.  # -------------------------------------------------------------------------
  698.  #     
  699.  #    "file::className"    --
  700.  #    
  701.  #  Extract root of file name as a class name for the file (obviously most
  702.  #  relevant to C++)
  703.  # -------------------------------------------------------------------------
  704.  ##
  705. proc file::className {} { return [file::baseName [win::CurrentTail]] }
  706.  
  707.  
  708. ## 
  709.  # -------------------------------------------------------------------------
  710.  #   
  711.  #  "file::coordinateProjectForMode" --
  712.  #  
  713.  #   When we create a new file or header automatically, it contains
  714.  #   information about our current project (as defined in docProject(...)).
  715.  #   Unfortunately we often forget to select the correct project first.
  716.  #   This procedure makes sure that your project is compatible with the
  717.  #   current mode, given the information in the 'docProject' array. If it isn't
  718.  #   then the current project is changed if a better match can be found. 
  719.  #         
  720.  #  Results:
  721.  #   None
  722.  #  
  723.  #  Side effects:
  724.  #   The current project may be changed
  725.  # -------------------------------------------------------------------------
  726.  ##
  727. proc file::coordinateProjectForMode {} {
  728.     global mode docProject
  729.     set currProj [file::projectName]
  730.     set projModes [lindex $docProject(default_modes) \
  731.       [lsearch -exact $docProject(name) [file::projectName]]]
  732.     if { $projModes != "" && [lsearch -exact $projModes $mode] == -1 } {
  733.     # this project doesn't like this mode.
  734.     # see if there's a better one
  735.     foreach modeLists $docProject(default_modes) {
  736.         if { [lsearch -exact $modeLists $mode] != -1 } {
  737.         # found a fit
  738.         set index [lsearch -exact $docProject(default_modes) $modeLists]
  739.         set proj [lindex $docProject(name) $index]
  740.         Docproj::changeProject "$proj"
  741.         return
  742.         }
  743.     }
  744.     }
  745. }
  746.  
  747. proc file::createNewClass {} {
  748.     global mode
  749.     # if the current project doesn't like this mode, then switch
  750.     file::coordinateProjectForMode
  751.     beep
  752.     set class [statusPrompt "A name for the new class:"]
  753.     set parent [statusPrompt "Descended from:" ]
  754.     switch -- $mode {
  755.     "C" -
  756.     "C++" {
  757.         file::createHeader [file::createDocument "new -n ${class}.cc" C++] $parent
  758.         file::createHeader [file::createDocument "new -n ${class}.h" C++] $parent
  759.     } 
  760.     "Tcl" {
  761.         file::createHeader [file::createDocument "new -n ${class}.tcl" Tcl] $parent
  762.     }
  763.     default {
  764.         message "No class procedure defined for your mode. Why not write one yourself?"
  765.     }
  766.     
  767.     }            
  768.     
  769. }
  770.  
  771.  
  772. ## 
  773.  # -------------------------------------------------------------------------
  774.  #   
  775.  # "file::updateGeneralDate" --
  776.  #  
  777.  #  Updates the date in the header of a file.  Normally this is the 
  778.  #  'last update' date, but we can override that if desired.
  779.  # -------------------------------------------------------------------------
  780.  ##
  781. proc file::updateGeneralDate { name {patt ""} {time ""}} {
  782.     if {$patt == ""} {set patt {last update: }}
  783.     regsub -all { } $patt "\[ \t\]" spatt
  784.     set pos [getPos]
  785.     set end [selEnd]
  786.     set hour {[0-9][0-9]?(:|\.)[0-9][0-9]((:|\.)[0-9][0-9])?([ \t][APap][Mm])?}
  787.     set date {[0-9][0-9]?(/|\.|\-)[0-9][0-9]?(/|\.|\-)[0-9][0-9]([0-9][0-9])?}
  788.     append spatt "\[ \t\]*" $date "(\[ \t]\{?" $hour {\}?)?}
  789.     set datePos [search -s -n -f 1 -r 1 -m 0 -l [pos::math [minPos] + 1000] $spatt [minPos]]
  790.     if {![llength $datePos]} {return}
  791.     if {$time == ""} {set time [mtime [now] short]}
  792.     if {[eval getText $datePos] == $time} {return}
  793.     eval replaceText $datePos [list $patt $time]
  794.     select $pos $end
  795. }
  796.  
  797. proc file::updateDate { {name ""} } {
  798.     set fr [win::Current]
  799.     if { $name == "" } {
  800.     set name $fr
  801.     }
  802.     if { $name != $fr } {
  803.     bringToFront $name
  804.     file::updateGeneralDate $name
  805.     bringToFront $fr
  806.     } else {
  807.     file::updateGeneralDate $name
  808.     }    
  809. }
  810.  
  811. proc file::updateCreationDate { name } {
  812.     if {[catch {getFileInfo [stripNameCount [win::Current]] info}]} {
  813.     set created [mtime [now]]
  814.     } else {
  815.     set created [mtime $info(created)]
  816.     }        
  817.     file::updateGeneralDate $name "created" $created
  818. }
  819.  
  820. proc file::newFunction {} {
  821.     elec::Insertion "[file::className]::•name•(•args•){\r\t•body•\r}\r"
  822. }
  823.  
  824. proc global::newDocumentTemplate { {subCall 0} } {
  825.     if {[catch {set newT [global::_editDocumentTemplate]}]} {return}
  826.     global elec::DocTemplates 
  827.     lappend elec::DocTemplates $newT
  828.     # save it permanently
  829.     global modifiedVars
  830.     lappend modifiedVars elec::DocTemplates
  831.     # add template to "prefs.tcl"
  832.     set procedure [lindex $newT 3]
  833.     set subproj [lindex $newT 5]
  834.     if {$procedure != "\#"} {
  835.     set def [file::_getDefault "Do you want to use this as the template?" t]
  836.     set t "\r"
  837.     append t "proc $procedure \{docname parentdoc"
  838.     if {$subproj != ""} { append t " subtype " }
  839.     append t "\} \{\r"
  840.     append t "\t# You must fill this in\r"
  841.     if {$subproj != ""} { append t "\t# Possible 'subtypes' are: $subproj\r" }
  842.     append t $def
  843.     append t "\r\treturn \$t\r\}\r"
  844.     addUserLine $t
  845.     if {[askyesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"] == "yes"} {
  846.         global::editPrefsFile
  847.         goto [maxPos]
  848.         if {$subCall} { 
  849.         alertnote "Once you've finished editing, hit cmd-N to go back and create a new document." 
  850.         # so our calling proc stops
  851.         error "Editing"
  852.         }
  853.     }
  854.     }
  855.     return [lindex $newT 1]
  856. }
  857.  
  858. proc file::_varValue {var} {
  859.     upvar $var a
  860.     if {[info exists a]} {
  861.     return $a
  862.     } else {
  863.     return ""
  864.     }
  865. }
  866.  
  867. proc file::_getDefault { text {default ""} {var ""}} {
  868.     if {[isSelection]} {
  869.     if {[askyesno "I notice you've selected some text. $text"] == "yes"} {
  870.         set default [getSelect]
  871.     } 
  872.     }
  873.     if {$default == ""} {
  874.     set default [getline "Enter template text (you can edit it later)" $default]
  875.     }
  876.     if {$var != ""} {
  877.     return [elec::_MakeIntoInsertion $default $var]
  878.     } else {
  879.     return $default
  880.     }
  881. }
  882.  
  883. proc global::_editDocumentTemplate {{def ""}} {
  884.     global DocprojmodeVars
  885.     if {$def == ""} {
  886.     set title "Create a new document template" 
  887.     set def {"" "" "By File Extension" "t_XXX" $DocprojmodeVars(currentProject) ""}
  888.     set new 1
  889.     } else {
  890.     set title "Edit document template" 
  891.     set new 0
  892.     }
  893.     
  894.     global docProject
  895.     set name ""
  896.     while { $name == ""} {
  897.     set y 40
  898.     set yb 220
  899.     set res [eval dialog -w 380 -h 340 \
  900.       [dialog::title $title 380] \
  901.       [dialog::button "OK" 290 yb] \
  902.       [dialog::button "Cancel" 290 yb] \
  903.       [dialog::textedit "Descriptive Name" [lindex $def 1] 10 y 15] \
  904.       [dialog::textedit "Modes (blank = all)" [lindex $def 0] 10 y 15] \
  905.       [dialog::textedit "Procedure name" [lindex $def 3] 10 y 15] \
  906.       [dialog::text "Descriptive header for this document template" 10 y] \
  907.       [dialog::text "(if 'Source', or 'Header', the mode must define" 10 y] \
  908.       [dialog::text "headerSuffices and sourceSuffices vars)" 10 y] \
  909.       [dialog::menu 10 y [list "None" "-" "Basic" "Source" "Header" "Either"] [lindex $def 2]] \
  910.       [dialog::text "Project name" 10 y] \
  911.       [dialog::menu 10 y $docProject(name) [lindex $def 4]] \
  912.       [dialog::textedit "List of sub-types" [lindex $def 5] 10 y 30] \
  913.       ]
  914.     if {[lindex $res 1]} { error "Cancel" } 
  915.     set i 1
  916.     foreach var {name modes procedure filetype proj subproj} {
  917.         set $var [lindex $res [incr i]]
  918.     }
  919.     if {$name == ""} { beep ; message "You must enter a name." }
  920.     }    
  921.     if {$modes == ""} {set modes "*"}
  922.     if {$filetype == "Either"} {set filetype "*"}
  923.     if {$proj == "None"} {set proj "*"}
  924.     if {$procedure == ""} {set procedure "\#"}
  925.     return [list $modes $name $filetype $procedure $proj $subproj]
  926.     
  927. }
  928.  
  929. proc global::editDocumentTemplate {} {
  930.     global modifiedVars elec::DocTemplates
  931.     set tlist [file::docTemplates] 
  932.     if {[catch {set l [listpick -p "Which document template do you want to edit?" $tlist]}]} {
  933.     return
  934.     }
  935.     set lind [file::docTemplateIndex $l]
  936.     if {[catch {set l [global::_editDocumentTemplate [file::docTemplateInfo $l]]}]} {
  937.     return
  938.     }
  939.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $lind $lind $l]
  940.     lappend modifiedVars elec::DocTemplates
  941. }
  942.  
  943. proc global::removeDocumentTemplate {} {
  944.     global modifiedVars elec::DocTemplates
  945.     set tlist [file::docTemplates] 
  946.     if {[catch {set l [listpick -p "Which document template shall I permanently remove?" $tlist]}]} {
  947.     return
  948.     }
  949.     set l [file::docTemplateIndex $l]
  950.     set elec::DocTemplates [lreplace ${elec::DocTemplates} $l $l]
  951.     lappend modifiedVars elec::DocTemplates
  952. }
  953.  
  954. ## Create this sort of stuff.
  955.  # set docProject(name) [list    "None" "EvoX" "Vince's Additions" "Cpptcl"]
  956.  # set docProject(addendum) {    {none} {evolution in complex systems} \
  957.  #       {an extension package for Alpha}    {connecting    C++    with Tcl} }
  958.  # set docProject(default_modes) { {}    {C C++}    {Tcl} {C C++ Tcl}}
  959.  ##
  960. proc global::newProject {} {
  961.     global docProject
  962.     if {[catch {global::_editProject} res]} {return}
  963.     set i -1
  964.     foreach var {name addendum license extra default_modes} {
  965.     lappend docProject($var) [lindex $res [incr i]]
  966.     }
  967.     global modifiedArrVars
  968.     lappend modifiedArrVars docProject
  969.     addMenuItem -m {Current Project} [lindex $res 0]
  970.     Docproj::changeProject [lindex $res 0]
  971. }
  972. proc global::_editProject {{def ""}} {
  973.     if {$def == ""} {
  974.     set title "Create a new project"
  975.     set def [list "Vince's Additions" \
  976.       "an extension package for Alpha" "seeFileLicenseTerms" \
  977.       "See the file \"license.terms\" for information on usage and redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES." ""]
  978.     } else {
  979.     set title "Edit a project"
  980.     }
  981.     set y 40
  982.     set yb 270
  983.     global elec::LicenseTemplates
  984.     set res [eval dialog -w 380 -h 325 \
  985.       [dialog::title $title 360] \
  986.       [dialog::button "OK" 290 yb] \
  987.       [dialog::button "Cancel" 290 yb] \
  988.       [dialog::textedit "Short Descriptive Name" [lindex $def 0] 10 y 15] \
  989.       [dialog::textedit "Longer Description to append to the above" [lindex $def 1] 10 y 25] \
  990.       [dialog::text "License type for header comments" 10 y] \
  991.       [dialog::menu 10 y ${elec::LicenseTemplates} [lindex $def 2]] \
  992.       [dialog::textedit "Additional text for end of header comments" [lindex $def 3] 10 y 35 5] \
  993.       [dialog::textedit "Modes (blank = all)" [lindex $def 4] 10 y 15] \
  994.       ]
  995.     if {[lindex $res 1]} { error "Cancel" }
  996.     return [lrange $res 2 6]    
  997. }
  998.  
  999. proc global::editProject {} {
  1000.     global docProject modifiedArrVars
  1001.     if {[catch {set l [listpick -p "Which project do you wish to edit?" \
  1002.       -L [file::projectName] $docProject(name)]}]} {
  1003.     return
  1004.     }
  1005.     
  1006.     set item [lsearch -exact $docProject(name) $l]
  1007.     foreach uvar {name addendum license extra default_modes} {
  1008.     lappend def [lindex $docProject($uvar) $item]
  1009.     }
  1010.     if {[catch {global::_editProject $def} def]} {return}
  1011.     set i -1
  1012.     foreach uvar {name addendum license extra default_modes} {
  1013.     set docProject($uvar) [lreplace $docProject($uvar) $item $item [lindex $def [incr i]]]
  1014.     }
  1015.     lappend modifiedArrVars docProject
  1016. }
  1017.  
  1018. proc global::removeProject {} {
  1019.     global docProject modifiedArrVars
  1020.     if {[catch {set l [listpick -p "Which project shall I permanently remove?" $docProject(name)]}]} {
  1021.     return
  1022.     }
  1023.     
  1024.     set item [lsearch -exact $docProject(name) $l]
  1025.     foreach uvar {name addendum license extra default_modes} {
  1026.     set docProject($uvar) [lreplace $docProject($uvar) $item $item]
  1027.     }
  1028.     lappend modifiedArrVars docProject
  1029.     if {[file::projectName] == $l} {
  1030.     Docproj::changeProject "None"
  1031.     }
  1032.     deleteMenuItem -m {Current Project} $l
  1033. }
  1034.  
  1035.